home *** CD-ROM | disk | FTP | other *** search
/ Programmer Plus 2007 / Programmer-Plus-2007.iso / Programming / Low Level Languages / FORTRAN.500 / DISK6 / FMHELLO.FO$ / FMHELLO.bin
Encoding:
Text File  |  1990-10-15  |  3.1 KB  |  126 lines
  1. CC  The FMHELLO program illustrates how to use multiple threads.
  2. CC
  3. CC  Use this command line to compile:
  4. CC
  5. CC      FL -MT fmhello.for
  6. CC
  7. CC  Or build the FORTRAN run-time DLL (using the FDLLOBJS batch file)
  8. CC  and compile with this command:
  9. CC
  10. CC      FL -MD fmhello.for frtexe.obj frtlib.lib
  11. CC
  12. CC  To run, specify the number of times you want each thread to say
  13. CC  hello. For example, to start three threads speaking 5, 7, and 9
  14. CC  times, respectively, use this command:
  15. CC
  16. CC      FMHELLO 5 7 9
  17. CC
  18.  
  19.       INTERFACE TO INTEGER*2 FUNCTION BEGINTHREAD(rtn, stk, size, arg)
  20.       INTEGER*4 rtn [value]
  21.       INTEGER*1 stk(*)
  22.       INTEGER*4 size
  23.       INTEGER*4 arg
  24.       END
  25.  
  26.       INTERFACE TO INTEGER*2 FUNCTION DosSleep( time )
  27.       INTEGER*4 time [value]
  28.       END
  29.  
  30. CC    Routine for each thread to say 'hello world'
  31. CC
  32.       SUBROUTINE child( loopcnt )
  33.  
  34.       INTEGER*4 loopcnt
  35.       INTEGER*4 i, result(2:32)
  36.       INTEGER*2 DosSleep, threadid, tid
  37.       LOGICAL*2 ready
  38.       AUTOMATIC tid, i
  39.       COMMON    ready, result
  40.  
  41.       tid = threadid()
  42.  
  43.       DO WHILE( .NOT. ready )
  44.          i = DosSleep( 0 )
  45.       END DO
  46.  
  47.       DO i = 1, loopcnt
  48.          WRITE (*,*) 'Hello world from thread ', tid
  49.       END DO
  50.  
  51. C
  52. C     Let the main program (thread 1) know thread is done.
  53. C
  54.       result(tid) = 1
  55.       END
  56.  
  57.  
  58. CC    Main code to launch threads.
  59. CC
  60.       INTEGER*4    result(2:32), hellocnt(31)
  61.       INTEGER*2    i, next, lastid, rc
  62.       INTEGER*2    BEGINTHREAD, DosSleep
  63.       INTEGER*1    stack [allocatable](:,:)
  64.       LOGICAL*2    ready
  65.       CHARACTER*10 argbuf
  66.       EXTERNAL     child
  67.       COMMON       ready, result
  68.  
  69.       i = NARGS() - 1
  70.       IF( i .GE. 32) STOP 'Error: Too many arguments'
  71.  
  72. C
  73. C     Allocate a 2K stack for each thread specified on the command line.
  74. C
  75.       IF( i .GT. 0) ALLOCATE( stack(2048, i) )
  76. C
  77. C     Bring up one thread for each argument.
  78. C
  79.       ready  = .FALSE.
  80.       lastid = 0
  81.  
  82.       DO next = 1, i
  83.          CALL GETARG( next, argbuf, rc )
  84.          READ (argbuf, '(I10)') hellocnt(next)
  85. C
  86. C        Bring up the new thread and pass the corresponding argument.
  87. C
  88.          rc = BEGINTHREAD( LOCFAR( child ),
  89.      +                     stack(1,next),
  90.      +                     2048,
  91.      +                     hellocnt(next) )
  92.  
  93. C
  94. C        Keep track of how many threads were brought up.
  95. C
  96.          IF( rc .GT. lastid ) lastid = rc
  97.  
  98.       END DO
  99.  
  100. C
  101. C     Tell the user how many threads were brought up.
  102. C
  103.       WRITE (*,*) 'Number of threads = ', next - 1
  104.       WRITE (*,*) 'Maximum thread ID = ', lastid
  105.  
  106. C
  107. C     Let the threads begin execution and wait for them to complete.
  108. C
  109.       ready = .TRUE.
  110.  
  111.       DO j = 1, next - 1
  112.          i = 2
  113. C
  114. C        Check until a thread signals completion.  Clear flag and
  115. C        start over, until all threads have finished.
  116. C
  117.          DO WHILE( result(i) .EQ. 0 )
  118.             rc = DosSleep( 0 )
  119.             i  = i + 1
  120.             IF( i .GT. lastid ) i = 2
  121.          END DO
  122.          result(i) = 0
  123.       END DO
  124.  
  125.       END
  126.